home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Snippets / HideMenuBar / HideMenuBar.p next >
Encoding:
Text File  |  1995-09-08  |  9.8 KB  |  429 lines  |  [TEXT/MWPS]
  1. {************************************************************}
  2. {*  This is a quick program to demonstrate hiding the menu}
  3. {*  bar in Pascal.}
  4. {*}
  5. {*  Written by Bill Catambay, 8/24/95.}
  6. {*}
  7. {*  This program hides the menu bar and creates a window which}
  8. {*  occupies the menu bar space (as well as the rest of the screen).}
  9. {*  It then animates a ball across the screen to demonstrate writing}
  10. {*  over the menu bar.  }
  11. {*}
  12. {*  It uses the sine wave function to animate the ball, and performs a "warp"}
  13. {*  when the ball hits the end (and slows the ball down and plays a sound for effect.}
  14. {*  It also continues the ball in the correct location from the wrap rather than }
  15. {*  starting it in the same place.  This was a bit tricky, but not too complicated. }
  16. {*}
  17. {*  9/8/95:  Fixed the ball to no longer flicker using offscreen worlds.  Added}
  18. {*  compiler directives to get program to work in both CodeWarrior and Think Pascal. }
  19. {*}
  20. {*  Send all comments to catambay@aol.com}
  21. {*  }
  22. {*************************************************************}
  23. Program HideMenuBar;
  24.  
  25. {$IFC UNDEFINED THINK_PASCAL}
  26. Uses
  27.     Fonts, Windows, Dialogs, ToolUtils, Resources, LowMem, QDOffscreen, SegLoad, Fp, Sound;
  28.  
  29. {$ELSEC}
  30. Uses
  31.     QDOffscreen, Sound;
  32.  
  33. Type
  34.     WindowRef = WindowPeek;
  35. {$ENDC}
  36.  
  37. Const
  38.     width = 20;
  39.     height = 20;
  40.     kResourceSoundComplete = 1;
  41.     kHandleSoundComplete = 2;
  42.     
  43. Var
  44.     save_mbar,i:    integer;
  45.     mBarRgn:        rgnHandle;
  46.     gBackWind:        WindowPtr;
  47.     gForeWind:        WindowPtr;
  48.     GrayRgn:        RgnHandle;
  49.     newPos,oldPos:    point;
  50.     newBox,oldBox:    rect;
  51.     mainRect:        rect;
  52.     err:            OSErr;
  53.     ticks:            longint;
  54.     deskPat:        PixPatHandle;
  55.     savePat:        GworldPtr;
  56.     y,k,pi:            real;
  57.     SndChan:         SndChannelPtr;
  58.     InPlay:            boolean; 
  59.     SndChanStat:     SCStatus;
  60.     MySound:         Handle;
  61.     wrapping:        boolean;
  62.       
  63. {$IFC UNDEFINED THINK_PASCAL}
  64. Procedure InitToolbox;
  65.  
  66.     begin    
  67.     initGraf(@qd.thePort);
  68.     initFonts;
  69.     initWindows;
  70.     initMenus;
  71.     TEinit;
  72.     initDialogs(nil);
  73.     MaxApplZone;
  74.     InitCursor;
  75.     end;
  76.  
  77. {$ELSEC}
  78. Function LMGetWindowList: WindowRef;
  79. Inline
  80. $2EB8, $09D6;            { MOVE.l $09D6,(SP) }
  81.  
  82. Function GetMBarHeight: INTEGER;
  83. Inline
  84. $3EB8, $0BAA;            { MOVE.w $0BAA,(SP) }
  85.  
  86. Function LMGetMBarHeight: Integer;
  87. Inline
  88. $3EB8, $0BAA;            { MOVE.w $0BAA,(SP) }
  89.  
  90. Procedure LMSetMBarHeight (value: Integer);
  91. Inline
  92. $31DF, $0BAA;            { MOVE.w (SP)+,$0BAA }
  93.  
  94. Function LMGetGrayRgn: RgnHandle;
  95. Inline
  96. $2EB8, $09EE;            { MOVE.l $09EE,(SP) }
  97.  
  98. {$ENDC}
  99.  
  100. Procedure SH_ForceUpdate(rgn:    RgnHandle);
  101.  
  102. Var
  103.     wpFirst:    WindowRef;
  104.     
  105.     begin
  106.     wpFirst := LMGetWindowList;
  107.     PaintBehind(wpFirst, rgn);                            
  108.     CalcVisBehind(wpFirst, rgn);                        
  109.     end;
  110.     
  111. Procedure GetMBarRgn(mbarRgn:    RgnHandle);
  112.  
  113. Var
  114.     mbarRect:    Rect;
  115.  
  116.     begin
  117. {$IFC UNDEFINED THINK_PASCAL}
  118.     mBarRect := qd.screenBits.bounds;
  119. {$ELSEC}
  120.     mBarRect := screenBits.bounds;
  121. {$ENDC}
  122.     mBarRect.bottom := mBarRect.top + save_mbar;
  123.     RectRgn(mBarRgn, mBarRect);                
  124.     end;
  125.  
  126. Function CenterWind(srect,mainrect:    rect): rect;
  127.  
  128. Var
  129.     wrect:    rect;
  130.     
  131.     begin
  132.     wrect.top := (mainrect.bottom - mainrect.top - (srect.bottom -
  133.         srect.top)) div 2 + mainrect.top;
  134.     wrect.bottom := wrect.top + (srect.bottom - srect.top);
  135.     wrect.left := (mainrect.right - mainrect.left - (srect.right -
  136.         srect.left)) div 2 + mainrect.left;
  137.     wrect.right := wrect.left + (srect.right - srect.left);
  138.     CenterWind := wrect;
  139.     end; { of centerwind }
  140.  
  141. Procedure PlayAsyncCallback (chan: SndChannelPtr; cmd: SndCommand);
  142.  
  143.     begin
  144.     InPlay := FALSE;
  145.     end;
  146.  
  147. Procedure SoundDispose;
  148.  
  149. Var
  150.     i:    integer;
  151.     
  152.     begin
  153.     if SndChan <> nil then
  154.         begin
  155.         Err := SndDisposeChannel(SndChan, True);
  156.         SndChan := nil;
  157.         inPlay := false;
  158.         end;
  159.     end;
  160.  
  161. Procedure ResetMbar;
  162.  
  163.     begin
  164.     LMSetMBarHeight(save_mbar);
  165.     DiffRgn(GrayRgn, mBarRgn, GrayRgn);    { remove the menu bar from the desktop }
  166.     DisposeRgn(mBarRgn);                { dispose the bar region }
  167.     DrawMenuBar;    
  168.     end;
  169.     
  170. Procedure ExitError;
  171.  
  172.     begin
  173.     ResetMbar;
  174.     ExitToShell;
  175.     end; 
  176.     
  177. Procedure BackgroundSound;
  178.     
  179. Var
  180.     MySndCmd: SndCommand;
  181.     SndHeaderPtr: SoundHeaderPtr;
  182.     i: integer;
  183. {$IFC UNDEFINED THINK_PASCAL}
  184.     sndUPP: SndCallBackUPP;
  185. {$ENDC}
  186.  
  187.     begin
  188. {$IFC UNDEFINED THINK_PASCAL}
  189.     sndUPP := NewSndCallBackProc(@PlayAsyncCallback);
  190.     Err := SndNewChannel(SndChan, sampledSynth, 0, sndUPP);
  191. {$ELSEC}
  192.     Err := SndNewChannel(SndChan, sampledSynth, 0, @PlayAsyncCallback);
  193. {$ENDC}
  194.     if err <> NoErr then
  195.         exit(BackgroundSound);
  196.     if SndChan = NIL then
  197.         exit(BackgroundSound);
  198.     HLock(mysound);
  199. {$IFC UNDEFINED THINK_PASCAL}
  200.     Err := SndPlay(SndChan, SndListHandle(mySound), True);
  201. {$ELSEC}
  202.     Err := SndPlay(SndChan, mySound, True);
  203. {$ENDC}
  204.     if err <> NoErr then
  205.         exit(BackgroundSound);
  206.     InPlay := TRUE;
  207.     with mySndCmd do
  208.         begin
  209.         cmd := callBackCmd;
  210.         param1 := 0;
  211.         param2 := 0;
  212.         end;
  213.     Err := SndDoCommand(SndChan, mySndCmd, False);
  214.     HUnlock(mysound);
  215.     end;
  216.  
  217. Procedure RemoveMbar;
  218.  
  219.     begin
  220.     save_mbar := GetMBarHeight;
  221.     mBarRgn := NewRgn;
  222.     GetMBarRgn(mBarRgn);                { make a region for the mbar }
  223.     LMSetMBarHeight(0);
  224.     GrayRgn := LMGetGrayRgn;
  225.     UnionRgn(GrayRgn,mBarRgn,GrayRgn);
  226.     SH_ForceUpdate(mBarRgn);
  227.     end;
  228.  
  229. Procedure SetBackground;
  230.  
  231. Var
  232.     r:    rect;
  233.     
  234.     begin
  235. {$IFC UNDEFINED THINK_PASCAL}
  236.     gBackWind := NewCwindow(Nil, qd.screenBits.bounds, '', FALSE, documentProc, 
  237.         Pointer(-1), TRUE, 0);
  238.     UnionRect(GrayRgn^^.rgnBBox, qd.screenBits.bounds, r);
  239. {$ELSEC}
  240.     gBackWind := NewCwindow(Nil, screenBits.bounds, '', FALSE, documentProc, 
  241.         Pointer(-1), TRUE, 0);
  242.     UnionRect(GrayRgn^^.rgnBBox, screenBits.bounds, r);
  243. {$ENDC}
  244.     MoveWindow(gBackWind, r.left, r.top, false);
  245.     SizeWindow(gBackWind, r.right-r.left+width, r.bottom-r.top, true);
  246.     BeginUpdate(gBackWind);
  247.     ShowWindow(gBackWind);
  248.     SetPort(gBackWind);    
  249.     { we want to set the origin of the window to be the origin }
  250.     { of the global coordinate system so that the pattern we }
  251.     { draw is not offset from the desktop's pattern }
  252.     SetOrigin(GrafPtr(gBackWind)^.portRect.left,GrafPtr(gBackWind)^.portRect.top);
  253.     r := gBackWind^.portRect;
  254.     FillCRect(r,GetPixPat(16));            { so use the 'ppat'=16 resource in system }
  255.     SetOrigin(0,0);                            
  256.     EndUpdate(gBackWind);
  257.     end;
  258.  
  259. Procedure SetForeground;
  260.  
  261. Var
  262.     r:    rect;
  263.     
  264.     begin
  265.     SetRect(r,0,0,400,100);
  266. {$IFC UNDEFINED THINK_PASCAL}
  267.     r := CenterWind(r, qd.screenBits.bounds);
  268. {$ELSEC}
  269.     r := CenterWind(r, screenBits.bounds);
  270. {$ENDC}
  271.     gForeWind := NewCwindow(NIL, r, '', TRUE, plainDbox, Pointer(-1),TRUE,0);
  272.     SetPort(gForeWind);
  273.     moveTo(20,20);
  274.     textsize(24);
  275.     DrawString('Look Mom!  No menu bar!');
  276.     moveTo(100,50);
  277.     textsize(10);
  278.     DrawString('Pascal sample by Bill Catambay');
  279.     moveTo(100,65);
  280.     DrawString('catambay@aol.com');
  281.     moveTo(50,90);
  282.     textsize(12);
  283.     DrawString('<press mouse button to quit>');
  284.     end;
  285.  
  286. {$IFC UNDEFINED THINK_PASCAL}
  287. {$ELSEC}
  288. Function Acos(radians: real): real;
  289.  
  290.     begin
  291.     acos := 3.14159265359;  {  Defined only for radians = -1 }
  292.     end;
  293.     
  294. Function Remainder(n,k: real): real;
  295.  
  296. Var
  297.     m: integer;
  298.     
  299.     begin
  300.     m := trunc(n / k);
  301.     remainder := n - m * k;
  302.     end;
  303. {$ENDC}
  304.  
  305. Procedure InitGlobals;
  306.  
  307. Var
  308.     r,s:            rect;
  309.     saveGD:        GDHandle;
  310.     saveGW:        GWorldPtr;
  311.     
  312.     begin
  313.     SetPt(oldPos,0,50+trunc(50*sin(0/20)));
  314.     SetRect(oldBox,oldPos.h,oldPos.v,oldPos.h+width,oldPos.v+height);
  315.     SetRect(r,0,0,gBackWind^.portRect.right,200);
  316.     GetGWorld(saveGW,saveGD);
  317. {$IFC UNDEFINED THINK_PASCAL}
  318.     Err := newGWorld(savePat,0,r,NIL,NIL,0);
  319. {$ELSEC}
  320.     Err := newGWorld(savePat,0,r,NIL,NIL,[]);
  321. {$ENDC}
  322.     if Err <> noErr then
  323.         ExitToShell;
  324.     if not LockPixels(savepat^.portPixMap) then
  325.         ExitToShell;
  326.     SetGWorld(savepat,NIL);
  327.     SetRect(r,0,0,gBackWind^.portRect.right-width,200);
  328.     CopyBits(gBackWind^.portbits,GrafPtr(savePat)^.portBits,r,r,srcCopy,NIL);
  329.     SetRect(r,gBackWind^.portRect.right-width,0,gBackWind^.portRect.right,200);
  330.     SetRect(s,0,0,width,200);
  331.     CopyBits(gBackWind^.portbits,GrafPtr(savePat)^.portBits,s,r,srcCopy,NIL);
  332.     UnlockPixels(savePat^.portPixMap);
  333.     SetGWorld(saveGW,saveGD);
  334.     SetPort(gBackWind);
  335.     k := 0;
  336.     pi := acos(-1);
  337.     mysound := GetNamedResource('snd ','Wrap');
  338.     wrapping := false;
  339.     end;
  340.  
  341. Procedure DrawBall;
  342.  
  343. Var
  344.     saveGD:        GDHandle;
  345.     saveGW:        GWorldPtr;
  346.     offRect:    rect;
  347.     tmpRect:    rect;
  348.     delta:        point;
  349.     offscreen:    gworldPtr;
  350.     wrap:        boolean;
  351.     
  352.     begin
  353.     newPos.h := oldPos.h + 2;
  354.     y := 50 + 50*sin((newPos.h+k)/30);
  355.     newPos.v := trunc(y);
  356.     if newPos.h > gBackWind^.portRect.right - width then
  357.         begin
  358.         k := remainder(newPos.h + k,pi * 60);
  359.         newPos.h := 0;
  360.         y := 50 + 50*sin((newPos.h+k)/30);
  361.         newPos.v := trunc(y);
  362.         end;
  363.     wrap := (newPos.h <= gBackWind^.portRect.right - width) and
  364.         (newPos.h + width > gBackWind^.portRect.right - width);
  365.     if wrap and (not wrapping) then
  366.         begin
  367.         SoundDispose;
  368.         BackgroundSound;
  369.         wrapping := true;
  370.         end
  371.     else if wrapping and (not wrap) then
  372.         wrapping := false;
  373.     SetRect(newBox,newPos.h,newPos.v,newPos.h+width,newPos.v+height);
  374.     UnionRect(newBox,oldBox,mainRect);
  375.     GetGWorld(saveGW,saveGD);
  376.     { mainRect top and left now become the offsets since newGworld sets offscreen starting at 0,0 }
  377.     delta.h := mainRect.left;
  378.     delta.v := mainRect.top;
  379.     offrect := mainRect;
  380.     offsetRect(offrect,-delta.h,-delta.v);
  381. {$IFC UNDEFINED THINK_PASCAL}
  382.     Err := newGWorld(offscreen,0,offrect,NIL,NIL,0);
  383. {$ELSEC}
  384.     Err := newGWorld(offscreen,0,offrect,NIL,NIL,[]);
  385. {$ENDC}
  386.     if Err <> noErr then
  387.         ExitError;
  388.     if not LockPixels(offscreen^.portPixMap) then
  389.         ExitError;
  390.     SetGWorld(offscreen,NIL);
  391.     CopyBits(grafptr(savepat)^.portbits,grafptr(offscreen)^.portbits,mainRect,offRect,srcCopy,NIL);
  392.     tmpRect := newBox;
  393.     OffsetRect(tmpRect,-delta.h,-delta.v);
  394. {$IFC UNDEFINED THINK_PASCAL}
  395.     FillOval(tmpRect, qd.black);
  396. {$ELSEC}
  397.     FillOval(tmpRect, black);
  398. {$ENDC}
  399.     SetGWorld(saveGW,saveGD);
  400.     SetPort(gBackWind);
  401.     CopyBits(grafptr(offscreen)^.portbits,gBackWind^.portBits,offRect,mainRect,srcCopy,NIL);
  402.     if wrap then
  403.         begin
  404.         tmpRect := mainRect;
  405.         OffsetRect(tmpRect,width-gBackWind^.portRect.right,0);
  406.         CopyBits(grafPtr(offscreen)^.portbits,gBackWind^.portBits,offRect,tmpRect,srcCopy,NIL);
  407.         end;
  408.     UnlockPixels(offscreen^.portPixMap);
  409.     DisposeGworld(offscreen);
  410.     oldPos := newPos;
  411.     oldBox := newBox;
  412.     if wrap then
  413.         Delay(1,ticks);
  414.     end; 
  415.         
  416. begin
  417. {$IFC UNDEFINED THINK_PASCAL}
  418. InitToolbox;
  419. {$ENDC}
  420. RemoveMbar;
  421. SetBackground;
  422. SetForeground;
  423. InitGlobals;
  424. SetPort(gBackWind);    
  425. repeat 
  426.     DrawBall;
  427. until button;
  428. ResetMbar;
  429. end.